home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
pnl006.zip
/
KB1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-17
|
16KB
|
517 lines
Unit kb1 ;
interface
Uses
Crt, Graph, Globals, Legal_U, Replay, LoadSave, Moves, TBMoves, Draw_Pcs;
procedure Get_Keyboard ( var Game_State : Game_State_Type ) ;
{ --------------------------------------------------------------- }
implementation
Type
Piece_Select_Type = record
Selected : boolean;
Coords : Coord_Type;
end;
procedure Arrow_Moves(var Cursor: Coord_Type; Piece_Select: Piece_Select_Type);
{ Author: Jonathan Loux
Purpose: To update cursor positions on the board.
Pre: Old Cursor coordinates.
Post: Updated Cursor coordinates and put to board.
}
var
Choice : char;
begin
Choice:= readkey;
with Cursor do
begin
Border_Square(Convert_File(xFile), Convert_Rank(Rank),brown);
case ord(Choice) of
75 : if Rank > 1 then dec(Rank) {left}
else beep;
77 : if Rank < 8 then inc(Rank) {right}
else beep;
71 : if (Rank > 1) and (xFile > 'a') then
begin
dec(Rank);
dec(xFile); {Home}
end
else
beep;
72 : if xFile > 'a' then dec(xFile) {up}
else beep;
73 : if (Rank < 8) and (xFile > 'a') then
begin
inc(Rank); {PgUp}
dec(xFile)
end
else beep;
79 : if (Rank > 1) and (xFile < 'h') then
begin
dec(Rank); {End}
inc(xFile)
end
else beep;
80 : if xFile < 'h' then inc(xFile) {down}
else beep;
81 : if (Rank < 8) and (xFile < 'h') then
begin
inc(Rank); {PgDn}
inc(xFile)
end
else beep;
117 : begin
Rank:= 1;
xFile:= 'h'
end;
118 : begin
Rank:= 8;
xFile:= 'h'
end;
119 : begin
Rank:= 1;
xFile:= 'a'
end;
132 : begin
Rank:= 8;
xFile:= 'a';
end;
end; {case}
Border_Square(Convert_File(xFile),Convert_Rank(Rank), yellow);
end; {with}
end; {Arrow_Moves}
{-------------------------------------------------------------------------}
procedure Beep2;
begin
sound(50);
delay(200);
nosound;
end; {beep2}
{-------------------------------------------------------------------------}
procedure Beep4;
begin
sound(50);
delay(50);
end;
{-------------------------------------------------------------------------}
procedure Select_A_Piece(Square: Coord_Type; PColor: integer; A_Piece: Piece_Type);
begin
with Square do
case A_Piece of
pawn : Draw_Pawn(xFile,Rank,PColor);
rook : Draw_Rook(xFile,Rank,PColor);
knight : Draw_Knight(xFile,Rank,PColor);
bishop : Draw_Bishop(xFile,Rank,PColor);
queen : Draw_Queen(xFile,Rank,PColor);
king : Draw_King(xFile,Rank,PColor);
end {case}
end; {S_A_P}
{-------------------------------------------------------------------------}
procedure Deselect(GS : Game_State_Type; var PS: Piece_Select_Type;
Curr_Move : Move_Type; Message: string);
begin
with GS do with PS do with Curr_Move do
begin
Selected:= false;
if Board[Coords.xFile,Coords.Rank].side = white then
Select_A_Piece(Coords,15,Move_Piece)
else
Select_A_Piece(Coords,0,Move_Piece);
Error_Display(Message);
end
end;
{-------------------------------------------------------------------------}
procedure Check_Move_Piece(var Game_State: Game_State_Type;
var Curr_Move: Move_Type;
var Cursor : Coord_Type;
var Piece_Select : Piece_Select_Type;
var Legal : Boolean);
{
Author: Jonathan Loux
Purpose: Checks if a piece is selected or not. If it isn't then it is
selected to be moved. Once one is selected, the procedure
checks if the square to where the piece is to be moved is not
the same as the piece. If it is and the game mode is novice then
the piece is unselected, otherwise it is not a valid key.
Pre: Old Game_State
Curr_Move = Null or coordinates of piece to move
Cursor = coordinates of the piece to move
Piece_Select = true if selected, false if not
Post: Game_State is changed in Handle_Move_Request
Curr_Move = coords of piece to move or destination
Cursor = coordinates of the piece to move
Piece_Select = true if selected and not moved yet, false if
deselected or moved.
}
var
count : integer;
A_Piece: Piece_Type;
begin
with Game_State do
begin
if Piece_Select.Selected = false then
{-------- Selecting a piece ---------------}
begin
if board[Cursor.xFile,Cursor.Rank].Side = Side_to_move then
{-- piece to be selected must be on the same side as Side to move --}
begin
Piece_Select.Selected:= true;
A_Piece:= board[Cursor.xFile,Cursor.Rank].Piece;
Piece_Select.Coords.Rank:= Cursor.Rank;
Piece_Select.Coords.xFile:= Cursor.xFile;
Select_A_Piece(Piece_Select.Coords,14,A_Piece);
with Curr_Move do
begin {---- set up initial coords of piece--}
From_F:= Cursor.xFile;
From_R:= Cursor.Rank;
Piece_Side:= Side_to_move;
Move_Piece:= A_Piece;
Move_Kind:= Checkall;
end; {with}
Legal_Move(Game_State,Curr_Move,Legal,count);
if count = 0 then
Deselect(Game_State,Piece_Select,Curr_Move,
'There are no legal moves for this piece.')
else
Error_Display('Piece Selected');
end {if board}
else
{-- if not the same side as side to move or empty square selected--}
Error_Display('ERROR: Not a piece to move')
end {if selected}
else
{---- A PIECE HAS BEEN SELECTED >> coords of Cursor are checked if
not the same as the piece ------------------------------------}
if (Cursor.xFile <> Piece_Select.Coords.xFile) or
(Cursor.Rank <> Piece_Select.Coords.Rank) then
begin
with Curr_Move do
begin
{----------entering destination coordinates------}
To_F:= Cursor.xFile;
To_R:= Cursor.Rank;
Move_Kind:= normal;
end; {with}
{------ checks if the move is legal ------------}
Legal_Move(Game_State, Curr_Move, Legal, count);
if Legal = true then
{------ if so then move is made -----------------}
begin
Handle_Move_Request(Game_State, Curr_Move, Move_History);
Piece_Select.Selected:= false;
Show_Text(Game_State,Move_History);
if Side_to_move = white then
Cursor.Rank:=4
else
Cursor.Rank:=5;
Cursor.xFile:= 'd';
with Cursor do
Border_Square(Convert_File(xFile),Convert_Rank(Rank),yellow);
if Curr_Move.Move_Kind = Check then
begin
if Curr_Move.Piece_Side = Black then
Error_Display('White is in Check')
else
Error_Display('Black is in Check');
end
else
if Curr_Move.Move_Kind <> Mate then
Error_Display('Move Completed.');
end
else
Error_Display('ERROR: Not a legal move');
end {if ok to move}
else
{------- if piece selected is selected again and mode = novice
then the piece is deselected ---------------------------}
begin
if Mode = novice then
Deselect(Game_State,Piece_Select,Curr_Move,'Piece Deselected')
else
Error_Display('ERROR: Not a legal move')
end; {else}
end; {the withs}
end; {Check_Move_Piece}
{--------------------------------------------------------------------------}
procedure Check_Legal_Piece(Game_State : Game_State_Type;
var Curr_Move : Move_Type;
Cursor : Coord_Type;
Piece_Select: Piece_Select_Type);
{
Author: Jonathan Loux
Purpose: Checks if the square selected has a piece from the same side as
the side to move and then calls Legal Moves Request
Pre: Old Game_State
Curr_Move = Null
Cursor = Coords of the piece to check legal moves
Post: Game_State is unchanged
Curr_Move = Coords of piece to check and the piece
Cursor is unchanged
}
var legal : boolean;
c: integer;
begin
with Game_State do with Curr_Move do
if board[Cursor.xFile,Cursor.Rank].Side = Side_to_move then
begin
From_F:= Cursor.xFile;
From_R:= Cursor.Rank;
Piece_Side:= Side_to_move;
Move_Kind:= ShowLegal;
Move_Piece:= board[Cursor.xFile,Cursor.Rank].Piece;
Legal_Move(Game_State, Curr_Move, Legal,c);
end
else
if Piece_Select.Selected = true then
Error_Display('Invalid Key')
else
Error_Display('ERROR: Not a piece to move');
end; {Check_Legal_Piece}
{------------------------------------------------------------------------}
procedure Handle_New_Game_Request(var Game_State: Game_State_Type);
var
Choice : char;
begin
InitGame(Game_State);
Draw_Board(Game_State);
end;
{------------------------------------------------------------------------}
procedure Get_Keyboard (var Game_State: Game_State_Type);
{
Author: Jonathan Loux
Purpose: Retrieves the information inputted from the keyboard. The type
of input is then processed and sent to the correct procedure.
Pre: Old Game_State
Post: End of game
}
var
Legal : Boolean;
TempGS : Game_State_Type;
GameOver : boolean;
AChoice,
Choice: char;
Cursor : Coord_Type;
Piece_Select : Piece_Select_Type;
begin
Legal := False;
GameOver := False;
Piece_Select.Selected:= false;
with Game_State do
begin
Cursor.Rank:= 4;
Cursor.xFile:= 'd';
repeat
Border_Square(Convert_File(Cursor.xFile),Convert_Rank(Cursor.rank), yellow);
repeat
Choice:= readkey;
if not (ord(Choice) in [0,13,76..78,81..84,108..110,113..116])
then Error_Display('Invalid Key');
until ord(Choice) in [0, 13, 76..78, 81..84, 108..110, 113..116];
case ord(Choice) of
{----- Arrow Keys ----------}
0 : Arrow_Moves(Cursor,Piece_Select);
{----- Move Request ---------}
13 : Check_Move_Piece(Game_State, Curr_Move, Cursor,
Piece_Select, Legal); {move request}
{----- Legal Move Request -------}
77, 109 : if Mode = novice then
Check_Legal_Piece(Game_State, Curr_Move, Cursor,
Piece_Select)
else
Error_Display('Invalid Key'); {legal moves}
{-------- Load Request -------------}
76, 108 : if Piece_Select.Selected = false then
Handle_Load_Request
(Game_File, G, Game_State,Move_History)
else
Error_Display('ERROR: Must finish move first');
{------ Save Request -----------------}
83,115 : if Piece_Select.Selected = false then
Handle_Save_Request
(Game_File, G, Game_State, Move_History)
else
Error_Display('ERROR: Must finish move first');
{------ Replay Request -------------}
82, 114 : if Piece_Select.Selected = false
then Handle_Replay_Request(Game_State)
else
Error_Display('ERROR: Must finish move first');
{------ Take Back Request --------------}
84, 116 : if Mode = Novice then
begin
if Piece_Select.Selected = false
then
begin
if Game_State.Move_Number > 1 then
Handle_Take_Back_Move_Request
(Game_State, Curr_Move, Move_History)
else
Error_Display('No moves to take back.')
end
else
Error_Display('ERROR: Must finish move first')
end {if M = N }
else
Error_Display('Invalid Key');
{------- New Game Request ----------}
78,110 : begin
AChoice := 'f';
while not (AChoice in ['y','Y','n','N']) do
begin
prompt('Save Game? (Y/N)');
AChoice := Readkey
end;
If AChoice in ['y','Y'] then
Handle_Save_Request(Game_File, G, Game_State, Move_History);
if Piece_Select.Selected = false then
Handle_New_Game_Request(Game_State)
else
Error_Display('ERROR: Must finish move first');
end;
{-------- Quit Game --------------}
81,113 : begin
AChoice := 'f';
while not (AChoice in ['y','Y','n','N']) do
begin
prompt('Save Game? (Y/N)');
AChoice := Readkey
end;
If AChoice in ['y','Y'] then
Handle_Save_Request
(Game_File, G, Game_State, Move_History);
end
end; {case}
GameOver := Curr_Move.Move_Kind=Mate;
if GameOver then
begin
AChoice := 'f';
while not (AChoice in ['Y','y','N','n']) do
begin
if Curr_Move.Piece_Side = white then
prompt('Check Mate! White Wins! Play again? (Y/N)')
else
prompt('Check Mate! Black Wins! Play again? (Y/N)');
AChoice := ReadKey;
if AChoice in ['Y','y'] then
begin
Handle_New_Game_Request(Game_State);
Show_Text(Game_State, Move_History);
GameOver := false;
end;
end;
end;
until (Choice in['Q', 'q']) or (GameOver);
end; {with}
end; { Get_Keyboard}
end. {KB1}